System Booster/System Booster.iso/Directorytools/DuM2/Src/DuDir.mod

Modula Implementation | 1996-09-27 | 6.4 KB | 240 lines

IMPLEMENTATION MODULE DuDir;

(*$S-,$T-,$A+*)

(* MODULE to read the directory of a current device or directory and
   place names/sizes into DirTable  - also to Sort them in alphabetical
   order (case insensitive)
*)

FROM SYSTEM             IMPORT  NULL,TSIZE,BYTE,ADR;
FROM Strings            IMPORT  InitStringModule, Assign, Length, Copy,Concat;
FROM Conversions        IMPORT  ConvertToString;
FROM Memory             IMPORT  MemReqSet, MemPublic,MemClear, AllocMem,
                                FreeMem;
FROM DOSFiles           IMPORT  Lock, Unlock, Examine, ExNext, FileLock,
                                FileInfoBlock, FileInfoBlockPtr;
FROM Intuition          IMPORT  PrintIText, IntuitionText;
FROM DuWindow           IMPORT  DuWindowPtr,WBColors,JamTwo,ResetSlider;

(* all these are importable
CONST
  MaxMax                = 300; (* Change this to allow more/less files   *)
                               (* Be warned it uses mucho runtime memory *)
                               (* 300 is enough even for my M2: directory*)
TYPE
  DirInfo       = RECORD
                    FileName    : ARRAY[0..30] OF CHAR;
                    IsDir       : BOOLEAN;
                    IsSelected  : BOOLEAN;
                    WasSelected : BOOLEAN;  (* for future RETAG addition *)
                    FileSize    : LONGCARD;
                  END;
  DirPtr        = POINTER TO DirInfo;
*)

TYPE
  CharPtr       = POINTER TO CHAR;

VAR
(* local variables *)
  fib           : FileInfoBlockPtr;
  lock          : FileLock;
(* Importable variables in .def file
  DirEntries    : CARDINAL;
  FileText      : IntuitionText;

    (* This table is full of pointers to allocated memory for storing
       directory entries   *)

  DirTable      : ARRAY[0..MaxMax] OF DirPtr;
  MaxFiles      : CARDINAL;
*)
(* INTERNAL CONSTANT *)
CONST
  MaxScreenFiles        = 15;

(*--------------------*)

PROCEDURE ReadDirectory(lock:FileLock):BOOLEAN;
VAR good:BOOLEAN;
(* Returns true if good read

   DirTable[0] contains the directory record and name.
   DirTable[1] - DirTable[DirEntries] contains filenames & other info *)

BEGIN
  fib := AllocMem(TSIZE(FileInfoBlock),MemReqSet{MemPublic});
  IF (fib = NULL) THEN RETURN FALSE END;
  IF Examine(lock,fib^) AND (fib^.fibDirEntryType > 0) THEN
    DirEntries := 0;
    REPEAT
      WITH fib^ DO
        Assign(DirTable[DirEntries]^.FileName,fibFileName);
        DirTable[DirEntries]^.IsDir      := (fibDirEntryType > 0);
        DirTable[DirEntries]^.FileSize   := fibSize;
        DirTable[DirEntries]^.WasSelected := FALSE;
        DirTable[DirEntries]^.IsSelected  := FALSE;
      END;
      INC(DirEntries);
    UNTIL (ExNext(lock,fib^) = FALSE) OR (DirEntries > MaxFiles);
    good := TRUE;
    DEC(DirEntries);
  ELSE
    good := FALSE;
  END;
  FreeMem(fib,TSIZE(FileInfoBlock));
  RETURN good;
END ReadDirectory;

(*------------*)

PROCEDURE FirstHigher (VAR lower,upper : ARRAY OF CHAR): BOOLEAN;
(* Compare dirtable entries filename part      *)
VAR i : CARDINAL;
 BEGIN
  FOR i := 0 TO 30 DO
        (* Test end-of-string cases *)
    IF (upper[i] = 0C) THEN
      IF (lower[i] = 0C) THEN RETURN FALSE ELSE RETURN TRUE END
    ELSIF (lower[i] = 0C) THEN
      RETURN FALSE
    END;
        (* If here, test character values *)
    IF (CAP(lower[i]) > CAP(upper[i])) THEN
      RETURN TRUE
    ELSIF (CAP(lower[i]) < CAP(upper[i])) THEN
      RETURN FALSE
    END;
  END;
  RETURN FALSE;
END FirstHigher;


PROCEDURE QSort;
VAR i,j : CARDINAL; Swap : BOOLEAN;
(* Sort the directory - DirEntries is top 1 is bottom   *)
(* QuickSort recursive calling *)

 PROCEDURE Sort(l,r:CARDINAL);
 VAR i,j:CARDINAL;
     x,w:DirPtr;
 BEGIN
   i := l; j := r;
   x := DirTable[(l + r) DIV 2];
   REPEAT
     WHILE FirstHigher(x^.FileName,DirTable[i]^.FileName) DO INC(i) END;
     WHILE FirstHigher(DirTable[j]^.FileName,x^.FileName) DO DEC(j) END;
     IF i <= j THEN
       w := DirTable[i];
       DirTable[i] := DirTable[j];
       DirTable[j] := w;
       INC(i);
       DEC(j);
     END;
   UNTIL (i > j);
   IF l < j THEN Sort(l,j) END;
   IF i < r THEN Sort(i,r) END;
 END Sort;

BEGIN
  Sort(1,DirEntries);
END QSort;

(*----------*)

PROCEDURE MoveString(VAR tgt,src:ARRAY OF CHAR; po,le:CARDINAL);
(* move max of 'le' chars of src to tgt[po] *)
(* not including ending null                *)
VAR s:CARDINAL;
BEGIN
  s := 0;
  WHILE (s < le) AND (src[s] <> 0C) DO;
    tgt[po+s] := src[s];
    INC(s);
  END;
END MoveString;

PROCEDURE DisplayName(file,pos:CARDINAL);
VAR m,t:CARDINAL;f,b:WBColors;
VAR StrNr:ARRAY[0..33] OF CHAR; Dun:BOOLEAN; GPString:ARRAY[0..38] OF CHAR;
BEGIN
  WITH DirTable[file]^ DO
    m := Length(FileName);
    IF m>28 THEN m := 28 END;
    GPString := "                                   "; (*35char*)
    f := Black; b := Blue;
    t := (pos * 8) + 16;
    IF (file>DirEntries) THEN
      b := Black;
    ELSIF IsDir THEN
      MoveString(GPString,FileName,0,m);
      IF IsSelected THEN
        b:= Green
      ELSE
        f := Green; b:= Black;
      END;
    ELSE
      MoveString(GPString,FileName,0,m);
      ConvertToString(FileSize,10,FALSE,StrNr,Dun);
      m := Length(StrNr);
      MoveString(GPString,StrNr,35-m,m);
      IF IsSelected THEN
        f := Black; b := White
      ELSE
        f := White; b := Black
      END;
    END;
    WITH FileText DO
      FrontPen := BYTE(ORD(f));
      BackPen := BYTE(ORD(b));
      DrawMode := BYTE(JamTwo);
      LeftEdge := 6;   TopEdge := t;
      ITextFont := NULL;  IText := ADR(GPString);
      NextText := NULL;
    END;
    PrintIText(DuWindowPtr^.RPort^,FileText,0,0);
  END;
END DisplayName;

PROCEDURE DisplayFiles(ind:CARDINAL);
VAR i:CARDINAL;
BEGIN
  FOR i := 1 TO MaxScreenFiles DO DisplayName(i+ind-1,i) END;
END DisplayFiles;

PROCEDURE NewDir;
VAR Vbod : CARDINAL;
(* Display a new directory *)
BEGIN
  Vbod := 0FFFFH;
  IF DirEntries > MaxScreenFiles THEN
    Vbod := 0FFFFH DIV DirEntries;
    Vbod := Vbod * MaxScreenFiles;
  END;
  ResetSlider(Vbod);
  DisplayFiles(1);
END NewDir;

PROCEDURE ClearTable;
VAR i:CARDINAL;
BEGIN
  FOR i := 0 TO MaxFiles DO
    FreeMem(DirTable[i],TSIZE(DirInfo))
  END;
END ClearTable;

BEGIN
  MaxFiles := 0;
  InitStringModule;
  (* Allocate memory for DirTable entries        *)
  (* items will be NULL if not available          *)
  (* Remember to free with ClearTable when exiting *)
  REPEAT
  DirTable[MaxFiles] := AllocMem(TSIZE(DirInfo),MemReqSet{MemPublic,MemClear});
    INC(MaxFiles);
  UNTIL (DirTable[MaxFiles-1] = NULL) OR (MaxFiles > MaxMax);
  DEC(MaxFiles);
END DuDir.